VERSION 5.00
Begin VB.Form FormControl 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Control"
   ClientHeight    =   675
   ClientLeft      =   3540
   ClientTop       =   2595
   ClientWidth     =   1920
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   675
   ScaleWidth      =   1920
   Begin VB.TextBox txtDDE 
      BackColor       =   &H00FFFFFF&
      ForeColor       =   &H00000000&
      Height          =   315
      Index           =   0
      Left            =   150
      TabIndex        =   0
      Top             =   150
      Visible         =   0   'False
      Width           =   1575
   End
End
Attribute VB_Name = "FormControl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Copyright © 1996-2000, Giddings & Lewis, LLC

Option Explicit

Private iConnections As Integer

Private Sub Form_Load()
    
    iConnections = 0                ' Initialize number of connections
    
End Sub

Public Function DDEWrite(sApp As String, sTopic As String, sItem As String, sData As String) As Integer
    
    Dim iConnect As Integer
    
    On Error GoTo errDDEWrite
    
    iConnect = FindConnection(sApp, sTopic)
    
    If iConnect = 0 Then
        iConnect = CreateConnection(sApp, sTopic)
        
        If iConnect = 0 Then
            DDEWrite = iConnect
            Exit Function
        End If
    End If
    
    txtDDE(iConnect).LinkItem = sItem       ' Set link item
    txtDDE(iConnect).Text = sData
    txtDDE(iConnect).LinkPoke               ' Set data

    DDEWrite = iConnect
    
    Exit Function
    
errDDEWrite:
    DDEWrite = 0
    Error Err
    Exit Function
    
End Function

Public Function DDERead(sApp As String, sTopic As String, sItem As String, sData As String, TimeOut As Single) As Integer
    
    Dim iConnect As Integer
    Dim StartTime As Single
    
    On Error GoTo errDDERead
    
    StartTime = Timer
        
    iConnect = FindConnection(sApp, sTopic)
    
    If iConnect = 0 Then
        iConnect = CreateConnection(sApp, sTopic)
        
        If iConnect = 0 Then
            DDERead = iConnect
            Exit Function
        End If
    End If
    
    txtDDE(iConnect).LinkItem = sItem       ' Set link item
    txtDDE(iConnect).LinkRequest            ' Get data

    sData = Trim$(txtDDE(iConnect).Text)
    DDERead = iConnect
    
    Exit Function
    
errDDERead:
    If Err = 286 Then
        ' Timeout while waiting for DDE response
        If Timer < (StartTime + TimeOut) Then
            Resume
        End If
    End If
    
    sData = ""
    DDERead = 0
    Error Err
    Exit Function
    
End Function

Private Function FindConnection(sApp As String, sTopic As String) As Integer
    Dim i As Integer
    Dim sConn As String
    
    sConn = Trim$(sApp) & "|" & Trim$(sTopic)
    
    For i = 1 To iConnections
        If sConn = txtDDE(i).LinkTopic Then
            FindConnection = i
            Exit Function
        End If
    Next i
    
    FindConnection = 0
    
End Function

Private Function CreateConnection(sApp As String, sTopic As String) As Integer
    
    On Error GoTo errCreateConnection

    Load txtDDE(iConnections + 1)
    iConnections = iConnections + 1
    
    ' Establish manual link
    txtDDE(iConnections).LinkTopic = Trim$(sApp) & "|" & Trim$(sTopic)
    txtDDE(iConnections).LinkMode = vbLinkManual
    
    CreateConnection = iConnections
    
    Exit Function
    
errCreateConnection:
    CreateConnection = 0
    Error Err
    Exit Function

End Function